home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Invisible Universe
/
Invisible Universe (1995)(Voyager)[Mac-PC].iso
/
mac
/
UNIVERSE
/
SHARED.DIR
/
01012_Script_dmd macros
< prev
next >
Wrap
Text File
|
1995-11-21
|
24KB
|
1,076 lines
--dmd
on resetAll
put the freebytes
set c = count(the windowList)
repeat with i = 1 to c
set w = getAt(the windowList, 1) -- keep trashing the first window
forget(w)
end repeat
clearGlobals
unloadCast 1,1000
if the machineType <> 256 then maxmem()
put the freebytes
end
on showall
repeat with i = 1 to 48
set the visibility of sprite i = 1
end repeat
end
on hideall48
repeat with i = 1 to 48
set the visibility of sprite i = 0
end repeat
end
on dumpListContents
set fullList to value(field "O.DIR")
repeat with i = 1 to count(fullList)
set el = getAt(fullList, i)
put "Image: (" & string(getPropAt(fullList, i)) & ") " & getAt(el, 1)
if count(el) > 2 then
set subList = getAt(el, 3)
-- get VIEWS, PHOTOS, & HOTSPOTS
set VIEWS = getaProp(subList, #VIEWS)
if voidP(VIEWS) then
set vc = 0
else
set vc = count(VIEWS)
end if
set PHOTOS = getaProp(subList, #PHOTOS)
if voidP(PHOTOS) then
set pc = 0
else
set pc = count(PHOTOS)
end if
set HOTSPOTS = getaProp(subList, #HOTSPOTS)
if voidP(HOTSPOTS) then
set hc = 0
else
set hc = count(HOTSPOTS)
end if
else
set vc = 0
set pc = 0
set hc = 0
end if
if vc > 1 then
repeat with j = 1 to vc
set v = getAt(VIEWS, j)
if v <> string(getPropAt(fullList, i)) then
set subViewName = getAt(getaProp(fullList, v), 1)
put " View: " & subViewName
end if
end repeat
end if
if pc > 0 then
repeat with j = 1 to pc
set v = getAt(PHOTOS, j)
if v <> string(getPropAt(fullList, i)) then
set subViewName = getAt(getaProp(fullList, v), 1)
put " Photo: " & subViewName
end if
end repeat
end if
if hc > 0 then
repeat with j = 1 to hc
set v = getAt(HOTSPOTS, j)
if v <> string(getPropAt(fullList, i)) then
set subViewName = getAt(getaProp(fullList, v), 1)
put " Hot spots: " & subViewName
end if
end repeat
end if
put ""
--if i = 40 then asdf
end repeat
end dumpListContents
on ScreenSaver
global gSS, gNavPalette, gCom
global gNavOffScreen
hideOverheadMenu
updateStage
if not gNavOffScreen and not voidP(gNavPalette) then
tell gNavPalette to lCloseNavPalette(1) -- will also close glossary
end if
cursor 4
set the randomSeed = the ticks
set gSS = 1
set showNameP = 1
set the mouseDownScript = "endScreenSaver"
set BigList = value(field "o.dir")
set listLen = count(BigList)
set listIndex = 1
set whichOne = random(listLen)
hideAll48
set shuffleList = [1]
repeat with i = 2 to listLen
set pos = random(i-1)
setAt(shuffleList, i, getAt(shuffleList, pos))
setAt(shuffleList, pos, i)
end repeat
repeat with i = 1 to listLen
set j = random(listLen)
set temp = getAt(shuffleList, i)
setAt(shuffleList, i, getAt(shuffleList, j))
setAt(shuffleList, j, temp)
end repeat
set the visibility of sprite 1 = 1
go to label("black frame")
cursor -1
repeat while gSS
if the optionDown or (the machineType = 256 and the shiftDown and the controlDown) then
if whichOne = listLen then
set whichOne = 1
else
set whichOne = whichOne + 1
end if
else
if listIndex = listLen then
set listIndex = 1
else
set listIndex = listIndex + 1
end if
set whichOne = getAt(shuffleList, listIndex)
end if
set imageName = getPropAt(BigList, WhichOne)
set info = getProp(BigList, imageName)
set mov = getAt(info, 2)
set imageName = string(imageName)
if the movie <> mov then
go to movie mov
hideAll48
if showNameP then showName
set the visibility of sprite 1 = 1
end if
go to frame imageName
go to the frame + 1
addToRetrace(imageName)
cursor -1
set t = (the ticks) + 300
repeat while t > the ticks
if the shiftDown then exit repeat
if the controlDown then
toggleName
updateStage
repeat while the controlDown
end repeat
set showNameP = not showNameP
end if
if the mouseDown then
set gSS = 0
set the mouseDownScript = empty
exit repeat
end if
end repeat
go to the frame - 1
--if i = 10 then exit repeat
end repeat
set gCom = 0
goGo("TOCM", 1) -- don't add to retrace... it's already done
--put ">>>done."
end ScreenSaver
on endScreenSaver
global gSS
set the mouseDownScript = empty
set gSS = 0
end endScreenSaver
--
--
-- Check that all celestial images begin with a proper label,
-- that the initial label has no image in channel 1, and that
-- the next frame has an image in channel 1 with a name that
-- matches the frame label.
--
on CheckImages startNum
if voidP(startNum) then set startNum = 1
set BigList = value(field "o.dir")
hideAll48
set the visibility of sprite 1 = 1
repeat with i = startNum to count(BigList)
set imageName = getPropAt(BigList, i)
set info = getProp(BigList, imageName)
set mov = getAt(info, 2)
set imageName = string(imageName)
put imageName && mov
if the movie <> mov then
--put ">>> Image #" & i
go to movie mov
hideAll48
set the visibility of sprite 1 = 1
end if
go to frame imageName
if the castNum of sprite 1 <> 0 then
Alert "Label" && imageName && "of movie" && mov && "is not blank"
exit repeat
end if
go to the frame + 1
if (the name of cast (the castNum of sprite 1)) <> (imageName & ".PIC") then
Alert imageName && "of movie" && mov && "is not present or not the same."
exit repeat
end if
go to the frame - 1
--if i = 10 then exit repeat
end repeat
put "done."
end CheckImages
on FindScrollScope
global gFile
if not voidP(gFile) then gFile(mDispose)
set gFile = fileIO(mNew, "write", the moviePath & "scroll and scope list")
set movieList = getAllMovieNames()
repeat with i = 1 to count(movieList)
set mov = getAt(movieList, i)
put "Movie: " & mov
go to movie mov
findSS
--put " "
--put " "
end repeat
gFile(mDispose)
put "done."
end FindScrollScope
on findSS
global gFile
set count = 0
repeat with i = 1 to 1000
set n = the name of cast i
if n = "SCROLL.PIC" then
set rp = the regPoint of cast i
erase cast i
importFileInto cast i, "Invisible Universe CD:FIXES FROM PAUL:SCROLL.PIC"
set the regPoint of cast i = rp
set ri = findEmpty(cast i)
importFileInto cast ri, "Invisible Universe CD:FIXES FROM PAUL:SCROLLR.PIC"
set the regPoint of cast ri = rp
put n && the name of cast i
end if
if n = "SCOPE.PIC" then
set rp = the regPoint of cast i
erase cast i
importFileInto cast i, "Invisible Universe CD:FIXES FROM PAUL:SCOPE.PIC"
set the regPoint of cast i = rp
set ri = findEmpty(cast i)
importFileInto cast ri, "Invisible Universe CD:FIXES FROM PAUL:SCOPER.PIC"
set the regPoint of cast ri = rp
put n && the name of cast i
end if
end repeat
end findSS
on ListTextCasts
global gFile
if not voidP(gFile) then gFile(mDispose)
set gFile = fileIO(mNew, "write", the moviePath & "TextCast Sprite 8")
set movieList = getAllMovieNames()
repeat with i = 1 to count(movieList)
set mov = getAt(movieList, i)
if char 1 of mov <> "O" then next repeat
put "Movie: " & mov
go to movie mov
checkSprite8
--put " "
--put " "
end repeat
gFile(mDispose)
put "done."
end ListTextCasts
on checkSprite8
global gFile
repeat with i = 1 to the lastFrame
go to frame i
set cn = the castNum of sprite 8
if cn <> 0 then
gFile(mWriteString, cn & "," & the movie && i & "-" & 8 & RETURN)
end if
repeat with j = 12 to 21
set cn = the castNum of sprite j
if cn = 0 then next repeat
set ty = the castType of cast (the castNum of sprite j)
if ty <> #text then next repeat
gFile(mWriteString, cn & "," & the movie && i & "-" & j & RETURN)
end repeat
end repeat
end checkSprite8
on ListLinkedCast
global gFile
if not voidP(gFile) then gFile(mDispose)
set gFile = fileIO(mNew, "write", the moviePath & "Linked Cast List")
set movieList = getAllMovieNames()
repeat with i = 1 to count(movieList)
set mov = getAt(movieList, i)
put "Movie: " & mov
go to movie mov
showLinkedCast
--put " "
--put " "
end repeat
gFile(mDispose)
put "done."
end ListLinkedCast
on showLinkedCast
global gFile
set count = 0
repeat with i = 1 to 1000
set fn = the fileName of cast i
if fn <> "" then
--if the castType of cast i <> #bitmap then next repeat
set fileHandle = fileIo(mNew, "read", fn)
set len = fileHandle(mGetLength)
fileHandle(mDispose)
gFile(mWriteString, fn & "," & len & "," & i & "," & the movie & RETURN)
-- put fn & "," & i & "," & the movie
-- set count = count + 1
-- if count = 10 then exit
end if
end repeat
end showLinkedCast
on getAllMovieNames
set movieList to []
repeat with i = 1 to 1023
set bob to getNthFileNameInFolder(the pathname,i)
if bob = "" then exit repeat
if bob = "Shared.Dir" then next repeat
if char(length(bob)-3) to length(bob) of bob <> ".DIR" then next repeat
add movieList,bob
end repeat
return movieList
end
--
--
-- Test code for substituting cast members
--
on substCast
repeat with i = 1 to 1
set listCast = the number of cast ("sort l" & i)
set count = the number of lines in field listCast
repeat with j = 1 to count
if char 1 of line j of field listCast <> "I" then next repeat
set fn = item 1 of line j of field listCast
set sz = integer(item 2 of line j of field listCast)
set cn = integer(item 3 of line j of field listCast)
set mv = item 4 of line j of field listCast
-- set fn2 = item 1 of line (j+1) of field listCast
-- set sz2 = integer(item 2 of line (j+1) of field listCast)
--
-- if (fn = fn2) and (sz = sz2) then
-- put "Dup: " & fn
-- next repeat
-- end if
--if sz > 6000 then next repeat
if the movie <> mv then
--put ">>> Saving old movie (" & the movie & ")"
saveMovie
--put ">>> Opening new movie (" & mv & ")"
go to Movie mv
--asdf
end if
put fn && sz && cn && mv
set rp = the regPoint of cast cn
erase cast cn
importFileInto cast cn, fn
set the regPoint of cast cn = rp
put ">" before char 1 of line j of field listCast
put the freeBytes
if the freeBytes < 1500000 then
saveMovie
unloadCast 1,1000
end if
if the freeBytes < 1000000 then asdf
end repeat
end repeat
put "done."
end substCast
--
--
-- Test code for deleting files in a list
--
on delFile
repeat with i = 1 to 1
set listCast = the number of cast ("sort l" & i)
set count = the number of lines in field listCast
repeat with j = 1 to count
if char 1 of line j of field listCast <> ">" then next repeat
set fn = item 1 of line j of field listCast
set fn = char 2 to length(fn) of fn
set sz = integer(item 2 of line j of field listCast)
set cn = integer(item 3 of line j of field listCast)
set mv = item 4 of line j of field listCast
set fileHandle = fileIo(mNew, "read", fn)
if not objectP(fileHandle) then next repeat
fileHandle(mDelete)
put "Deleted: " & fn
put "+" before char 1 of line j of field listCast
end repeat
end repeat
end delFile
--
--
-- Test code for substituting cast members
--
on remLinesFile
repeat with i = 1 to 4
set listCast = the number of cast ("sort l" & i)
put "Checking Cast" & listCast
set count = the number of lines in field listCast
repeat with j = count down to 1
if char 1 of line j of field listCast = "I" then next repeat
delete line j of field listCast
end repeat
end repeat
put "Done."
end remLinesFile
--
--
-- code to copy cast 1-89 with names of the destination in the shared cast
--
on MoveNewText
repeat with i = 1 to 89
set num = integer(the name of cast i)
set name = the name of cast num
put num && name
copyToClipBoard cast i
pasteClipBoardInto cast (num)
set the name of cast (num) = name
-- if i = 10 then asdf
end repeat
end MoveNewText
on dropPunct str
global gPunctuation
set c = length(str)
repeat with i = 1 to c
if gPunctuation contains char c of str then
set c = c - 1
else
return char 1 to c of str
end if
end repeat
return char 1 to c of str
end
on cleanTextCastScripts
set j = 0
repeat with i = 2000 to 3002
if the name of cast i = 0 then
set the scriptText of cast i = ""
--put ">>>> changed cast " & i
if the castType of cast i = #text then
if (the text of field i) = "" then erase cast i
end if
end if
put the freeBytes
if the freeBytes < 1500000 then
saveMovie
unloadCast 1,1000
end if
set j = j + 1
if j = 100 then
beep
set j = 0
end if
end repeat
put "Done."
end cleanTextCastScripts
on setTextCastScripts
set j = 0
repeat with i = 2000 to 3002
if the castType of cast i = #Text then
set the scriptText of cast i = "on mouseDown" & return & " doTextClick(" & i & ")" & return & "end"
end if
put the freeBytes
if the freeBytes < 1500000 then
saveMovie
unloadCast 1,1000
if the machineType <> 256 then maxmem()
end if
set j = j + 1
if j = 100 then
beep
set j = 0
end if
end repeat
put "Done."
end setTextCastScripts
on findBold fileName
findStyle "bold", fileName, 2135, 3002
end
on findUnderlineText mc, cn
global gPunctuation
set thePhrase = char mc of field cn
set i = mc - 1
repeat while i > 0
if (the textStyle of char i of field cn) <> "underline" then exit repeat
set thePhrase = char i of field cn & thePhrase
set i = i - 1
end repeat
set i = mc + 1
set last = the number of chars of field cn
repeat while i <= last
if (the textStyle of char i of field cn) <> "underline" then exit repeat
set thePhrase = thePhrase & char i of field cn
set i = i + 1
end repeat
set l = the number of chars in thePhrase
repeat while gPunctuation contains (char l of thePhrase)
set l = l - 1
if l = 0 then
alert "Note that char " & mc && "of cast" && cn && "is only punctuation."
put "*** Note that char " & mc && "of cast" && cn && "is only punctuation."
put quote & char (mc - 4) to (mc + 4) of field cn & quote
asdf
end if
end repeat
if l = 1 then
put "*** Single char phrase at char " & mc & " in cast " & cn
end if
set thePhrase = char 1 to l of thePhrase
return thePhrase
end findUnderlineText
on findUnderline fileName
findStyle2 "underline", fileName, 2254,2254 --2000, 3002
end
on findStyle2 style, fileName, startN, endN
global gPunctuation, gUnderlineCount
global fh
set gUnderlineCount = length(field "Underline List")
put "Looking for words that are: " & style
set gPunctuation = ":,.;)(" & quote & " " & return
if objectP(fh) then fh(mDispose)
set fh = fileIO(mNew, "write", the moviePath & fileName)
repeat with i = startN to endN
set num = the number of chars in field i
set printedCast = 0
set c = 1
repeat while c < num
if the textStyle of char c of field i contains style then
if the textStyle of char c of field i contains "," then
put "**** cast " & i & " contains mixed styles"
alert "**** cast " & i & " contains mixed styles"
asdf
end if
if not printedCast then
set printedCast = 1
put "Cast:" && i
end if
set thePhrase = findUnderlineText(c, i)
set c = c + the number of chars in thePhrase
set mapsTo = underLineLookUp(thePhrase, i)
if mapsTo = 0 then
set glossLoc = " *** unknown phrase"
else
set glossLoc = " -> " & the name of cast mapsTo && "cast " & mapsTo
end if
fh(mWriteString, ¼
thePhrase & "---- cast " & i & " " & the name of cast i & glossLoc & RETURN)
end if
set c = c + 1
end repeat
--if i = (startN + 20) then exit repeat
end repeat
fh(mDispose)
put "done."
end
on underLineLookUp thePhrase, cn
global gUnderlineCount
--
--
-- Find the start of the phrase, find the ">", look to see if there
-- is a "," after the 4-digit cast number, if so check for a match
-- on the text that was clicked, otherwise match.
--
set off = 0
repeat while 1
set off = offset(thePhrase, (char off to gUnderlineCount of field "Underline List"))
--put char off to off+length(thePhrase)-1 of field "underline list"
if off = 0 then return 0
set off2 = offset(">", char off to gUnderlineCount of field "Underline List")
if off2 = 0 then return 0
set off = off + off2
if (char (off+4) of field "Underline List") = "," then
set matchCast = integer(char (off+5) to (off+8) of field "Underline List")
if cn <> matchCast then next repeat
end if
return integer(char (off) to (off+3) of field "Underline List")
end repeat
end underLineLookUp
on findStyle style, fileName, startN, endN
global gPunctuation
put "Looking for words that are: " & style
set gPunctuation = ":,.;)(" & quote & " " & return
set fh = fileIO(mNew, "write", the moviePath & fileName)
repeat with i = startN to endN
set num = the number of words in field i
set firstOne = -1
set printedCast = 0
repeat with w = 1 to num
if the textStyle of word w of field i contains style then
if firstOne = -1 then
set firstOne = w
--put "first one = " & w
end if
else
if firstOne > -1 then
if not printedCast then
set printedCast = 1
put "Cast:" && i
end if
put word firstOne to (w - 1) of field i into phrase
--put "Last one = " & (w - 1)
set phrase = dropPunct(phrase)
--if not (the text of field castN contains phrase) then
--put phrase & "---- cast " & i & RETURN after field castN
fh(mWriteString, phrase & "---- cast " & i & " " & the name of cast i & RETURN)
--end if
set firstOne = -1
end if
end if
end repeat
if firstOne > -1 then
if not printedCast then
set printedCast = 1
put "Cast:" && i
end if
put word firstOne to (w - 1) of field i into phrase
--put "Last one = " & (w - 1)
set phrase = dropPunct(phrase)
--if not (the text of field castN contains phrase) then
-- put phrase & "---- cast " & i & RETURN after field castN
fh(mWriteString, phrase & "---- cast " & i & " " & the name of cast i & RETURN)
--end if
end if
end repeat
fh(mDispose)
put "done."
end
on MemoryWaterMark str
global gMemFree
set a = gMemFree
set gMemFree = the freeBytes
--put ">>>" & str && gMemFree && gMemFree / 1024 & "k" && (a - gMemFree) && (a - gMemFree)/1024 & "k"
end MemoryWaterMark
on compilePropertyList
set cn = the number of cast "property list"
repeat with i = 64 to 67
put i
set name = item 5 of line i of field cn
set num = the number of cast name
if num = -1 then asdf
put num into item 5 of line i of field cn
set name = item 6 of line i of field cn
set num = the number of cast name
if num = -1 then asdf
put num into item 6 of line i of field cn
end repeat
end compilePropertyList
on lineItem s
if voidP(s) then set s = 1
set f = the number of cast "property list"
set n = the number of lines in field f
repeat with i = s to n
put i into item 1 of line i of field f
end repeat
end lineItem
on setSpaces15
set k = 0
-- repeat with i = 2135 to 3002
repeat with i = 2925 to 3002
set c = the number of chars in field i
repeat with j = 1 to c
if char j of field i = " " then
set the textSize of char j of field i = 15
--put ">>> set char to5"
end if
end repeat
put the freeBytes
if the freeBytes < 1500000 then
saveMovie
unloadCast 1,1000
end if
set k = k + 1
put i
--if k = 2 then asdf
end repeat
put "Done."
end setSpaces15
on testEmptyCast fir, las
repeat with i = fir to las
if the castType of cast i <> #text then
put "Cast " & i
exit
end if
end repeat
put "Done."
end testEmptyCast
on keyDown
checkKeyDowns
end keyDown
on checkKeyDowns
global gFindString, gFindStringPos
--beep
if (the machineType = 256 and the controlDown) or the commandDown then
if (the key = "q") then doQuit
if (the key = "f") then doFind
if (the key = "h") then doHelp
if (the key = "g") then doGlossary
exit
end if
--put ">>>the key = " && the key && the keyCode
dontPassEvent
end checkKeyDowns
